{-# LANGUAGE DeriveDataTypeable         #-}
{-# OPTIONS -Wall #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  DirectoryScript.Lib.HierSyntax
-- Copyright   :  (c) Stephen Peter Tetley 2012
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  experimental
-- Portability :  to be determined
--
-- Hierarchical syntax - nesting.
--
-----------------------------------------------------------------------------


module DirectoryScript.Lib.HierSyntax 
  (
    Directory(..)
  , File(..)            -- re-export
  , DateTime(..)        -- re-export

  , directoryFullPath
  , makeHier

  ) where


import DirectoryScript.Lib.Base
import qualified DirectoryScript.Lib.FlatSyntax as F
import DirectoryScript.Lib.FlatSyntax ( File(..) )


import Data.Generics                    -- package: syb

import Data.List ( foldl', isPrefixOf )

data Directory = Directory
    { dir_path_to           :: String
    , dir_name              :: String
    , dir_datetime          :: DateTime
    , dir_subdirs           :: [Directory]
    , dir_files             :: [File]
    }
  deriving (Eq,Show,Data,Typeable)


directoryFullPath :: Directory -> String
directoryFullPath d = dir_path_to d ++ ('\\': dir_name d)


--------------------------------------------------------------------------------
-- Building

makeHier :: [F.Directory] -> [Directory]
makeHier = topDown


topDown :: [F.Directory] -> [Directory]
topDown = foldl' (flip insert) []


-- | /Forest/ insert
--
insert :: F.Directory -> [Directory] -> [Directory]
insert a [] = [node1 a]
insert a (d:ds) 
   | a `descendent` d = insertT a d : ds
   | otherwise        = d : insert a ds




-- | /Tree/ insert
--
insertT :: F.Directory -> Directory -> Directory
insertT a dir = case dir_subdirs dir of
   [] -> dir { dir_subdirs = [node1 a] }
   xs -> dir { dir_subdirs = insert a xs }


descendent :: F.Directory -> Directory -> Bool
descendent fd dir = (directoryFullPath dir) `isPrefixOf` (F.dir_path fd)


node1 :: F.Directory -> Directory
node1 dir = Directory
    { dir_path_to       = pathto
    , dir_name          = name
    , dir_datetime      = F.dirDateTime dir
    , dir_subdirs       = []
    , dir_files         = F.dirFiles dir
    }
  where
    (pathto,name) = pathSplit $ F.dir_path dir

-- spans :: String -> [F.Directory] -> ([F.Directory], [F.Directory])
-- spans root = span (F.dirIsChild root)



pathSplit :: String -> (String,String)
pathSplit = post . foldr fn (False,[],[]) 
  where
    fn '\\' (False,ds,ss) = (True,    ds,   ss)
    fn c    (False,ds,ss) = (False,   ds, c:ss)
    fn c    (True, ds,ss) = (True,  c:ds,   ss)

    post (_,b,c)          = (b,c)

